home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Collection of Tools & Utilities
/
Collection of Tools and Utilities.iso
/
comm
/
suncom.zip
/
WINDOWS.PAS
< prev
Wrap
Pascal/Delphi Source File
|
1990-01-19
|
6KB
|
218 lines
{ Windows - A Turbo Pascal 5.0 Unit. - Written By Boyd Fletcher
USE: WindowIn - To make a temporary window.
WindowOut - To remove the temporary window.
NOTE: Windows cannot be overlapped. That is you cannot use WindowIn twice
in a row without WindowOut being placed after the first WindowIn.
USE: MakeWindow - Places a permanent window on the screen. It can only be
removed by a WINDOW(1,1,80,25) and a CLRSCR command.
}
UNIT Windows;
INTERFACE
USES CRT,DOS;
VAR WindowPtr : Pointer;
CursorCol, CursorRow : Integer;
PROCEDURE FrameTypes(Mode : Integer; VAR TL,TR,BL,BR,H,V : Char);
PROCEDURE Frame(TopCol,TopRow,BotCol,BotRow,Mode : Integer);
PROCEDURE WindowIn(ForeGround,BackGround,Mode,TopCol,TopRow,
BotCol,BotRow : Integer;
VAR CursorCol, CursorRow : Integer;
VAR WindowPtr : Pointer);
PROCEDURE WindowOut(CursorCol, CursorRow : Integer;
VAR WindowPtr : Pointer);
PROCEDURE MakeWindow(ForeGround,BackGround,Mode,NoClr,
TopCol,TopRow,BotCol,BotRow : Integer);
PROCEDURE SetScreen(ForeGround,BackGround,NoClr,TopCol,
TopRow,BotCol,BotRow : Integer);
PROCEDURE SizeCursor(Top, Bot : Byte);
PROCEDURE OnCursor;
PROCEDURE OffCursor;
FUNCTION Clr(Color,
Mode : Integer) : Char;
(*****************************************************************************)
IMPLEMENTATION
PROCEDURE SizeCursor;
VAR Reg : Registers;
BEGIN {SizeCursor}
with Reg do
begin
ax := 1 shl 8;
cx := Top shl 8 + Bot;
INTR($10,Reg);
end
END; {SizeCursor}
(*****************************************************************************)
PROCEDURE OnCursor;
BEGIN {OnCursor}
SizeCursor(6,7);
END; {OnCursor}
(*****************************************************************************)
PROCEDURE OffCursor;
BEGIN {OffCursor}
Sizecursor(14,0);
END; {OffCursor}
(*****************************************************************************)
PROCEDURE FrameTypes;
BEGIN {Frame Types}
case Mode of
1 : begin
TL := #201; TR := #187;
BL := #200; BR := #188;
H := #205; V := #186;
end;
2 : begin
TL := #214; TR := #183;
BL := #211; BR := #189;
H := #196; V := #186;
end;
3 : begin
TL := #213; TR := #184;
BL := #212; BR := #190;
H := #205; V := #179;
end;
4 : begin
TL := #218; TR := #191;
BL := #192; BR := #217;
H := #196; V := #179;
end;
end;
END; {Frame Types}
(*****************************************************************************)
PROCEDURE Frame;
VAR x : Integer;
TL,TR,BL,BR,H,V : Char;
BEGIN {Frame}
FrameTypes(Mode,TL,TR,BL,BR,H,V);
gotoXY(TopCol,BotRow);
write(BL);
gotoXY(BotCol,BotRow);
write(BR);
gotoXY(TopCol,TopRow);
write(TL);
gotoXY(BotCol,TopRow);
write(TR);
for x := TopRow+1 to BotRow-1 do
begin
gotoXY(TopCol,x);
write(v);
gotoXY(BotCol,x);
write(v);
end;
for x := TopCol+1 to BotCol-1 do
begin
gotoXY(x,TopRow);
write(h);
gotoXY(x,BotRow);
write(h);
end;
END; {Frame}
(*****************************************************************************)
PROCEDURE WindowIn;
TYPE ScrnArray = Array[0..3999] of Byte;
ScreenPtr = ^ScrnArray;
VAR ScreenAddress : Word;
ScrnPtr : ScreenPtr;
BEGIN {Window In}
if (mem[0000:1040] and 48) <> 48
then ScreenAddress := $B800
else ScreenAddress := $B000;
mark(WindowPtr);
new(ScrnPtr);
CursorCol := whereX;
CursorRow := whereY;
move(mem[ScreenAddress:0000],ScrnPtr^,4000);
textcolor(ForeGround);
textbackground(BackGround);
if Mode <> 0 then FRAME(TopCol,TopRow,BotCol,BotRow,Mode);
textcolor(ForeGround);
textbackground(BackGround);
window(TopCol+1,TopRow+1,BotCol-1,BotRow-1);
clrscr;
dispose(ScrnPtr);
END; {Window In}
(*****************************************************************************)
PROCEDURE WindowOut;
VAR ScreenAddress : Word;
BEGIN {Window Out}
if (mem[0000:1040] and 48) <> 48
then ScreenAddress := $B800
else ScreenAddress := $B000;
move(WindowPtr^,mem[ScreenAddress:0000],4000);
if WindowPtr <> Nil then dispose(WindowPtr);
window(1,1,80,25);
gotoXY(CursorCol,CursorRow);
END; {Window Out}
(*****************************************************************************)
PROCEDURE MakeWindow;
BEGIN {Make Window}
window(1,1,80,25);
textcolor(ForeGround);
textbackground(BackGround);
if Mode <> 0 then FRAME(TopCol,TopRow,BotCol,BotRow,Mode);
textcolor(ForeGround);
textbackground(BackGround);
window(TopCol+1,TopRow+1,BotCol-1,BotRow-1);
if NoClr = 0 then clrscr;
END; {Make Window}
(*****************************************************************************)
PROCEDURE SetScreen;
BEGIN {SetScreen}
window(TopCol,TopRow,BotCol,BotRow);
textcolor(ForeGround);
textbackground(BackGround);
if NoClr = 0 then clrscr;
END; {SetScreen}
(*****************************************************************************)
FUNCTION Clr;
BEGIN {Clr}
if Mode = 0 then textcolor(Color);
if Mode = 1 then textbackground(Color);
Clr := #0;
END; {Clr}
END. {UNIT - Windows}